;; Mode: LISP; Syntax: Common-lisp; Package: aklemme                           
;; Names: Ardell Klemme, Bruce Ho, Jimmy Cumming         Date: 10/10/12                    
;; Course: ICS 313   Assignment: 5                                         
;; File: Assignment5.lisp

;; AK: Comment Heuristics :
;;      - Be sure to include initials at the beginning of comments.
;;      - Be sure to comment only on code which you have modified.
;;      - Always add comments, never remove another person's comments.

; AK: Contains code from Land of Lisp Book and from my previous work

;JC
;this prevents Allegro from chopping off messages                               
;printed by our text adventure game      
(setf tpl:*print-length* nil)


; AK: defines nodes that contain locations and descriptions                          
(defparameter *nodes* '((living-room (you are in the living-room.
                            a wizard is snoring loudly on the couch.))
                        (garden (you are in a beautiful garden.
                            there is a well in front of you.))
                        (attic (you are in the attic.
                            there is a giant welding torch in the corner.))))
                            
; AK: describes description associated with location parameter                       
(defun describe-location (location nodes)
   (cadr (assoc location nodes)))

; AK: defines list of edges at each location and their direction/path                
(defparameter *edges* '((living-room (garden west door)
                                     (attic upstairs ladder))
                        (garden (living-room east door)
                                     ; AK: adds edge to new location
                                     (armory underground passage-way))
                        (attic (living-room downstairs ladder))
                        ; AK: this is the new location with edge back
                        (armory (garden up passage-way))))

; AK: describes path and direction for each edge                                     
(defun describe-path (edge)
  `(there is a ,(caddr edge) going ,(cadr edge) from here.))

; AK: describes paths available from this location                                   
(defun describe-paths (location edges)
  (apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))

; AK: defines all objects in the game.                                               
(defparameter *objects* '(whiskey bucket frog chain scabbard blade hilt
                          crossguard stone-of-power))

; AK: define multi-part object - the sword of omens here.                            
(defparameter *multi-part-obj* '(sword-of-omens
                                 (blade hilt crossguard stone-of-power)))

; AK: defines all object location associations.
(defparameter *object-locations* '((whiskey living-room)
                                   (bucket living-room)
                                   (chain garden)
                                   (frog garden)
                                   (scabbard armory)
                                   ; AK: place sword-of-omen pieces in world         
                                   (blade attic)
                                   (hilt living-room)
                                   (crossguard armory)
                                   (stone-of-power garden)))

; AK: shows only objects at location                                                 
(defun objects-at (loc objs obj-loc)
   (labels ((is-at (obj)
              (eq (cadr (assoc obj obj-loc)) loc)))
       (remove-if-not #'is-at objs)))

; AK: describes objects in current location                                          
(defun describe-objects (loc objs obj-loc)
   (labels ((describe-obj (obj)
                `(you see a ,obj on the floor.)))
      (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc)))))

; AK: set default location to living-room              
(defparameter *location* 'living-room)

; AK: displays current location and information about location, paths available      
;     and objects in current location                                                
(defun look ()
  (append (describe-location *location* *nodes*)
          (describe-paths *location* *edges*)
          (describe-objects *location* *objects* *object-locations*)))
          
; AK: walks in given direction, if it is a valid direction, else give error msg.
; AK: this now handles the command when no arguments are given
(defun walk (&optional (direction "nowhere"))
  (cond ((equal direction "nowhere")
         `(you must specify which direction to go.))
   (t
    (labels ((correct-way (edge)
             (eq (cadr edge) direction)))
    (let ((next (find-if #'correct-way (cdr (assoc *location* *edges*)))))
      (if next
          (progn (setf *location* (car next))
                 (look))
          '(you cannot go that way.)))))))

; AK: picks up an object if it exists in current location, puts onto body            
;     (inventory). 
; AK: This now handles the command without arguments                                                                    
(defun pickup (&optional (object "nothing"))
  (cond ((equal object "nothing")
         `(you must specify something to pickup.))
        ((member object
                 (objects-at *location* *objects* *object-locations*))
         (push (list object 'body) *object-locations*)
          `(you are now carrying the ,object))
        (t '(you cannot get that.))))

; AK: lists all objects in inventory                                                 
(defun inventory ()
  (cons 'items- (objects-at 'body *objects* *object-locations*)))

; AK: checks inventory for a specific object, returns t/nil                          
(defun have (object)
    (member object (cdr (inventory))))
    
; AK: help function - print available commands                                  
(defun help ()
  `(you can use one of the following commands- ,@*allowed-commands*))

; AK: alias to help, just lets user call help with "h" instead                  
(defun h ()
  (help))




;JC This is a function from Dr. Reed's samples
(defun our-member (obj lst)
  (if (null lst)
      nil
      (if (eql (caar lst) obj)
          t
          (our-member obj (cdr lst)))))


;JC This is a function from Dr. Reed's samples
;modified for objects
(defun our-member-obj (obj lst)
  (if (null lst)
      nil
      (if (eql (car lst) obj)
          t
          (our-member-obj obj (cdr lst)))))


;;;=========================R-E-P-L=======================;;;
; AK: custom read-eval-print-loop                                                    
; AK: recursively calls repl unless user exits with 'quit command.                   
(defun game-repl ()
    (let ((cmd (game-read)))
        (unless (eq (car cmd) 'quit)
            (game-print (game-eval cmd))
            (game-repl))))

; AK: custom read function takes string arguments and adds parenthesis around it     
;     and adds quote for function command.                                           
(defun game-read ()
    (let ((cmd (read-from-string (concatenate 'string "(" (read-line) ")"))))
         ; AK: function adds quote to data portion of command string                 
         (flet ((quote-it (x)
                    (list 'quote x)))
             (cons (car cmd) (mapcar #'quote-it (cdr cmd))))))

; AK: defines available input from user such that users cannot "hack" the game.      
(defparameter *allowed-commands* '(look walk pickup inventory help h))

; AK: limits available input from user                                               
(defun game-eval (sexp)
    (if (member (car sexp) *allowed-commands*)
        (eval sexp)
        '(i do not know that command.)))

; AK: capitalize first letter of each sentence                                       
(defun tweak-text (lst caps lit)
  (when lst
    (let ((item (car lst))
          (rest (cdr lst)))
      (cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
            ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
            ((eql item #\") (tweak-text rest caps (not lit)))
            (lit (cons item (tweak-text rest nil lit)))
            (caps (cons (char-upcase item) (tweak-text rest nil lit)))
            (t (cons (char-downcase item) (tweak-text rest nil nil)))))))

; AK: custom print function to handle output from interface.                         
(defun game-print (lst)
    (princ (coerce (tweak-text (coerce (string-trim "() "
                                                     (prin1-to-string lst))
                                       'list)
                               t nil)
                   'string))
    (fresh-line))

;;;==========================Macros===============================;;;           

; AK: For the next project, we'll put these in another lisp file                

; AK: macro for new objects, need to push to *objects* and                      
;     to the *object-location*                                                  
(defmacro new-object (name location)
  `(progn
     (cond
      ((not (our-member-obj ',name *objects*))
      (pushnew ',name *objects*)
      (pushnew '(,name ,location) *object-locations*))
     (t "Object already exists"))))

; AK: test: add new object pillow to living-room                                
(new-object pillow living-room)


; AK: Main macro for the new locations in game. We need to push a               
;     new node with name and description.                                       
(defmacro new-location (name &body body)
  (cond
   ((not (member 'name *edges*))
    `(pushnew '(,name (,@body)) *nodes*))
   (t "Location already exists")))

; AK: Adding a few new locations in to test                                     
(new-location armory you are in an armory.
              you see weapons hanging on the walls.
              you also see a forge in the middle of the room.)
(new-location lanai you are on the lanai. you can see the garden below.)


; AK: This is the main macro for setting up new actions in game.
;     Basically, the parameters are straight forward and this makes it
;     easy to add new actions/commands to the game.
(defmacro game-action (command subj obj place &body body)
  `(progn (defun ,command (subject object)
            (if (and (eq *location* ',place)
                     (eq subject ',subj)
                     (eq object ',obj)
                     (have ',subj))
                ,@body
	      '(i cant ,command like that.)))
          (pushnew ',command *allowed-commands*)))

;JC 
;(the-room (other-room direction means)
;(optional (third-room direction means))
;(defmacro new-edge (room room1 direction1 route1 &optional (room2 nil ) &optional2 (direction2 "") &optional3 (route2 ""))
;  (cond
 ;  ((member room *nodes*)
  ;  `(pushnew '(,room (,room1 ,direction1 ,route1)) *edges*))
  ;  ("Location does not exist")))

; AK: Adding a few new locations in to test                                     
(new-location `armory you are in an armory.
              you see weapons hanging on the walls.
              you also see a forge in the middle of the room.)
(new-location `lanai you are on the lanai. you can see the garden below.)
				      

; AK: We want to default the state of the bucket to unwelded
(defparameter *chain-welded* nil)

; AK: Now we can go in and set the dependencies for bucket to be welded
;     Must have the chain and bucket and be in the attic, and must
;     be trying to use the weld command.
(game-action weld chain bucket attic
             (if (and (have 'bucket) (not *chain-welded*))
                 (progn (setf *chain-welded* 't)
                        '(the chain is now securely welded to the bucket.))
               '(you do not have a bucket.)))

; AK: We start with the bucket not having any water in it
(defparameter *bucket-filled* nil)

; AK: Now we can create the dunk action and allow the bucket
;     to be filled for splashing on the Wizard.
(game-action dunk bucket well garden
             (if *chain-welded*
                 (progn (setf *bucket-filled* 't)
                        '(the bucket is now full of water))
               '(the water level is too low to reach.)))

; AK: This is the final action for splashing the Wizard in the face with
;     cold water and waking him up.
(game-action splash bucket wizard living-room
             (cond ((not *bucket-filled*) '(the bucket has nothing in it.))
                   ((have 'frog)
                    '(the wizard awakens and sees that you stole his frog.
                          he is so upset he banishes you to the
                          netherworlds- you lose! the end.))
                   (t
                    '(the wizard awakens from his slumber and greets you
                          warmly. he hands you the magic low-carb donut
                          - you win! the end.))))

; AK: Again, starting with an unforged sword, forge action needs to be
;     generated.
(defparameter *sword-forged* nil)
    
; AK: This is the action to forge the Sword of Omens.
; AK: Jimmy/Bruce, this action could be updated to better work with the
;     multi-part-object.  Feel free to change this.
(game-action forge blade hilt armory
             (cond ((not (have 'stone-of-power)) 
                    '(you're missing the stone of power.))
                   ((not (have 'crossguard))
                    '(you're missing the crossguard.))
                   ((equal *sword-forged* t)
                    '(the sword of omens is already forged.))
                   (t (progn (setf *sword-forged* 't)
                    '(you have successfully forged the sword of omens.)))))

; AK: We need new actions as a result of the sword being forged.
;     Perhaps we can cut the chain off the bucket, kill the frog, or slay
;     the wizard in a duel?  We can set up a whole bunch of actions for a
;     duel with the wizard, such as 'slash' 'stab' 'energy-blast'
;     etc. If you guys want, we can script the duel so that you are given
;     verbal queues from the wizard and we can then enable actions like
;     'dodge' or 'block' and 'counterstrike' or 'riposte'. We can even set
;     a window for the player to use the correct attack in order to defeat
;     the wizard, otherwise we continue to loop the battle.  We could even
;     randomize wizard's abilities or states.  We should discuss next week.
